:- import "%%/lib/expression.sl" #


-- Flow Constructs --

Parse.File .filename .tree :-
	scanner.new .scanner,
	scanner.twoCharSymbols .scanner ("->", ">>", "<<", "- ", "--", "-=", "=-",),
	scanner.lineCommenter .scanner (SYM "--"),
	scanner.openCommenter .scanner (SYM "-="),
	scanner.closeCommenter .scanner (SYM "=-"),
	,
	parser.new .parser,
	parser.scanner .parser .scanner,
	parser.operators .parser (
		ASGop (SYM "=") LEFT,
		ADDop (SYM "+") LEFT,
 		SUBop (SYM "- ") RIGHT,
		MULop (SYM "*") LEFT,
		DIVop (SYM "/") RIGHT,
		MODop (ID "mod") RIGHT,
		(SYM "(") (SYM ")") PAREN,
	),
	parser.nodeParser .parser Parse.ExpressionNode,
	set.pointer PARSER .parser,
	,
	stream.readFile IN.PGM.FILE .filename,
	scan.readFrom .scanner IN.PGM.FILE,
	Parse.Declarations .parser .tree,
	once (scan.EOF .scanner; Error "Unparsable token"),
	stream.close IN.PGM.FILE
	,
	parser.dispose .parser,
	scanner.dispose .scanner ! #

Parse.Declarations .parser (.declare, .remains) :-
	Parse.Declaration .parser .declare,
	Parse.Declarations .parser .remains ! #
Parse.Declarations . $ #

Parse.Declaration .parser (.decl) :-
	scan.match (parser.scanner .parser ^) (ID .var),
	Parse.DeclType .parser .var .decl ! #

Parse.DeclType .parser .name (TYPEDEF .type .name) :-
	scan.match (parser.scanner .parser ^) (ID "represents") !
	Parse.Type .parser .type #
Parse.DeclType .parser .name (.vardef) :-
	parser.scanner .parser .scanner,
	Expect .scanner (ID "as") ! Parse.Type .parser .type,
	if (scan.match .scanner (SYM "=")) then (
		parse.expression .parser .value,
		.vardef = VARDEFVALUE .type .name .value
	) else (
		.vardef = VARDEF .type .name
	) #

Parse.Block .parser (.tree) :-
	parser.scanner .parser .scanner,
	scan.match .scanner (SYM "[") !
	Parse.Statements .parser .tree,
	Expect .scanner (SYM "]") #

Parse.Statements .parser (.stmt, .remains) :-
	Parse.Statement .parser .stmt, Parse.Statements .parser .remains ! #
Parse.Statements . $ #

Parse.Statement .parser (BLOCK .tree) :-
	Parse.Block .parser .tree ! #
Parse.Statement .parser (.declare) :-
	scan.match (parser.scanner .parser ^) (ID "declare") !
	Parse.Declaration .parser .declare #
Parse.Statement .parser (.stmt) :-
	parser.scanner .parser .scanner,
	scan.match .scanner (ID "if") !
	parse.expression .parser .cond,
	Expect .scanner (ID "then"),
	Parse.Statement .parser .then,
	if (scan.match .scanner (ID "else")) then (
		Parse.Statement .parser .else,
		.stmt = IFELSE .cond .then .else
	) else (
		.stmt = IF .cond .then
	) #
Parse.Statement .parser (WHILE .cond .do) :-
	scan.match (parser.scanner .parser ^) (ID "while") !
	parse.expression .parser .cond, Parse.Statement .parser .do #
Parse.Statement .parser (EXPR .expression) :-
	parse.expression .parser .expression #


-- Types --

Parse.Type .parser (.t1) :-
	Parse.BasicType .parser .t0,
	Parse.TypeDeco .parser .t0 .t1 #

Parse.BasicType .parser (INTTYPE 1) :-
	scan.match (parser.scanner .parser ^) (ID "i8") #
Parse.BasicType .parser (INTTYPE 4) :-
	scan.match (parser.scanner .parser ^) (ID "i32") #
Parse.BasicType .parser .func :- -- Function prototype
	scan.match (parser.scanner .parser ^) (ID "function") !
	Parse.Function .parser .func #
Parse.BasicType .parser (CLASS .decls) :-
	parser.scanner .parser .scanner,
	scan.match .scanner (ID "class") ! -- Class declaration
	Expect .scanner (SYM "["),
	Parse.Declarations .parser .decls,
	Expect .scanner (SYM "]") #
Parse.BasicType .parser (TYPENAME .name) :-
	scan.match (parser.scanner .parser ^) (ID .name) ! #
Parse.BasicType .parser (.type) :-
	parser.scanner .parser .scanner,
	scan.match .scanner (SYM "("),
	Parse.Type .parser .type,
	Expect .scanner (SYM ")") #
Parse.BasicType . (VOID) :-
	Error "Bad type definition" #

Parse.TypeDeco .parser .t0 (.ret) :- -- Pointer
	scan.match (parser.scanner .parser ^) (SYM "*") !
	Parse.TypeDeco .parser (PTR .t0) .ret #
Parse.TypeDeco .parser .t0 (.ret) :- -- Array
	parser.scanner .parser .scanner,
	scan.match .scanner (SYM "{") !
	scan.match .scanner (NUM .size),
	Expect .scanner (SYM "}"),
	Parse.TypeDeco .parser (ARRAY .size .t0) .ret #
Parse.TypeDeco . .type .type #

	-- Parses function parameter list
Parse.Function .parser (FUNC .parms .return .block) :-
	Parse.Prototype .parser .parms,
	if (scan.match (parser.scanner .parser ^) (SYM "->")) then (
		Parse.Type .parser .return
	) else (
		.return = VOID
	), (
		Parse.Block .parser .block;
		.block = $
	) #

Parse.Prototype .parser (VARDEF .type .name, .remains) :-
	Parse.Declaration .parser (VARDEF .type .name),
	if (scan.match (parser.scanner .parser ^) (SYM ","))
		then (Parse.Prototype .parser .remains)
		else (.remains = $) #
Parse.Prototype . $ #


-- Basic Elements --

Parse.ExpressionNode .parser .node :-
	Parse.IfMember .parser .n0,
	if (scan.match (parser.scanner .parser ^) (SYM "^")) then (
		Parse.CallParameters .parser .params,
		.node = CALL .n0 .params
	) else (
		.node = .n0
	) ! #

Parse.CallParameters .parser (.param, .remains) :-
	scan.match (parser.scanner .parser ^) (SYM "\") !
	Parse.IfMember .parser .param,
	Parse.CallParameters .parser .remains #
Parse.CallParameters . $ #

Parse.IfMember .parser (.node) :-
	Parse.Basic .parser .basic,
	parser.scanner .parser .scanner,
	if (scan.match .scanner (SYM "~")) then ( -- Accessing a member
		Expect .scanner (ID .field),
		.node = MEMBER .basic .field
	) else (
		.node = .basic
	) ! #

Parse.Basic .parser .id :-
	scanBasicValue (parser.scanner .parser ^) .id #

scanBasicValue .scanner (NUM .number) :- scan.match .scanner (NUM .number) ! #
scanBasicValue .scanner (STR .string) :- scan.match .scanner (STR .string) ! #
scanBasicValue .scanner (VAR .var) :- scan.match .scanner (ID .var) ! #

Expect .scanner .token :-
	scan.match .scanner .token ! #
Expect .scanner (.type .sym) :-
	bound .type,
	scan.next .scanner, -- Eats it up and avoid loops
	concat "Expected: " .sym .message,
	Error .message ! #
Expect .scanner (ID .) :-
	scan.next .scanner,
	Error "Identifier expected" #
